package NG::Sys::Cached::Mixed;
use strict;
use warnings;
use utf8;

use NG::Sys::Cached::Common;
our @ISA = qw(NG::Sys::Cached::Common::Parent);

sub init {
	my ($self) = @_;
	$self->SUPER::init;
	unless($self->{dbh}){
		die "need dbh";
	}
	$self->{tables} ||= [];
	$self->{extern} ||= [];

	$self->{record_class} ||= 'NG::Sys::Cached::Mixed::Record';

	
	# fileld -> pos in $self->{_tables}[]
	$self->{hash_fields} = {};
	# все доступные методы
	$self->{fields} = [];
	# namespace -> pos in $self->{_tables}[]
	$self->{table_pos} = {};
	# массив для хранения всех внутренних объектов 
	$self->{_tables} = [];
	
	# массив для внешних объектов
	$self->{_extern} = [];
	# field -> pos in $self->{ext}[]
	$self->{hash_extern} = {};

	Extend::soft_require($self->{record_class});

	if($self->{subclass}){
		$self->{record_class} = $self->make_subclass($self->{record_class});
		#no strict 'refs';
		#my $root = $self->{_extern};
		#*{$self->{record_class}."::__extern"} = eval "sub {
		#	my \$self = shift;
		#	my \$pos = shift;
		#	return \$self->{_extern}[\$pos] ||= \$root->[\$pos]->{object}->get_obj(\$self->{id},\$self->{readonly});
		#}";
	}else{
		if(ref $self->{record_class}){
			die "cannot combine record_class without sublassing";
		}
		if($self->{compile}){
			die "need subclassing for compile";
		}
	}

	for my $create_param(@{$self->{extern}}){
		$self->add_extern($create_param);
	}
	
	for my $create_param(@{$self->{tables}}){
		$self->add_table($create_param);
	}
	return $self;
}
sub check_field {
	my ($self,$key) = @_;
	return exists $self->{hash_fields}{$key} || die "unexists key'".$key."' checked\n";
}
sub add_extern {
	my $self = shift;
	my $create_param;
	if(ref $_[0]){
		$create_param = shift;
	}elsif(@_ % 2){
		die "odd number params\n";
	}else{
		$create_param = { @_ };
	}
	
	unless($create_param->{class}){
		die "need class\n";
	}

	Extend::soft_require($create_param->{class});
	
	unless($create_param->{namespace} ||= $create_param->{table}){
		die "need namespace or table class='$create_param->{class}'\n";
	}
	unless(exists $create_param->{cache}){
		$create_param->{cache} = $self->{cache};
	}
	$create_param->{app} = $self->{app};
	$create_param->{dbh} = $self->{dbh};
	
	push @{$self->{_extern}},$create_param;
	my $pos = $#{$self->{_extern}};
	my $field = $create_param->{namespace};
	
	if(defined $self->{hash_fields}{$field}){
		die "intercross extern '".$field."' and '".
			$self->{_tables}[$self->{hash_fields}{$field}]{namespace}."'\n";
	}
	if(defined $self->{hash_extern}{$field}){
		die "intercross extern '".$field."'\n";
	}
	
	$self->{hash_extern}{$field} = $pos;
	
	if(exists $self->{table_pos}{$create_param->{namespace}}){
		die "redefine extern '$create_param->{namespace}' with namespace";
	}

	$create_param->{object} = $create_param->{class}->new(%$create_param);

	if($self->{compile}){
		no strict 'refs';
		my $root = $create_param->{object};
		*{$self->{record_class}."::".$field} = eval "sub {
			my \$self = shift;
			return \$self->{_extern}[$pos] ||= \$root->get_obj(\$self->{id},\$self->{readonly});
		}";
	}

}
sub add_table {
	my $self = shift;
	my $create_param;
	if(ref $_[0]){
		$create_param = shift;
	}elsif(@_ % 2){
		die "odd number params\n";
	}else{
		$create_param = { @_ };
	}
	
	unless($create_param->{class}){
		die "need class\n";
	}

	Extend::soft_require($create_param->{class});
	
	unless($create_param->{namespace} ||= $create_param->{table}){
		die "need namespace or table class='$create_param->{class}'\n";
	}
	unless($create_param->{fields}){
		die "need fields for $create_param->{namespace}\n";
	}
	unless(exists $create_param->{cache}){
		$create_param->{cache} = $self->{cache};
	}
	$create_param->{app} = $self->{app};
	$create_param->{dbh} = $self->{dbh};
	
	push @{$self->{_tables}},$create_param;
	my $pos = $#{$self->{_tables}};
	
	for my $field (@{$create_param->{fields}}){
		if(defined $self->{hash_fields}{$field}){
			die "intercross field '".$field."' for '".
				$create_param->{namespace}."' and '".
				$self->{_tables}[$self->{hash_fields}{$field}]{namespace}."'\n";
		}
		if(defined $self->{hash_extern}{$field}){
			die "intercross field '".$field."' for '".
				$create_param->{namespace}."' and '".
				"extern '".$field."'\n";
		}
		$self->{hash_fields}{$field} = $pos;
		push @{$self->{fields}}, $field;
	}
	
	if($create_param->{blobs}){
		push @{$self->{blobs}},@{$create_param->{blobs}};
		@{$self->{hash_blobs}}{@{$create_param->{blobs}}} = (1) x @{$create_param->{blobs}};
	}
	
	if(exists $self->{table_pos}{$create_param->{namespace}}){
		die "redefine namespace '$create_param->{namespace}'";
	}
	if(exists $self->{hash_extern}{$create_param->{namespace}}){
		die "redefine namespace '$create_param->{namespace}' with extern";
	}
	$self->{table_pos}{$create_param->{namespace}} = $pos;
	$create_param->{object} = $create_param->{class}->new(%$create_param);
	
	if($create_param->{creator}){
		if(defined $self->{create_pos}){
			die $create_param->{namespace}." override previos creator ".
				$self->{_tables}[$self->{create_pos}]->{namespace}."\n";
			
		}
		unless($create_param->{object}->can("create")){
			die $create_param->{namespace}." cannot create\n"
		}
		unless($create_param->{object}->{pkey}){
			die $create_param->{namespace}." has not pkey\n"
		}
		$self->{create_pos} = $pos;
	}
	if($create_param->{searcher}){
		unless($create_param->{object}->can("get_by_name")){
			die $create_param->{namespace}, " cannot get_by_name\n"
		}
		unless($create_param->{object}->can("search_name")){
			die $create_param->{namespace}, " cannot search_name\n"
		}
		$self->{searchers}{$create_param->{object}->search_name} = $pos;
		if($create_param->{creator}){
			if(defined $self->{search_pos}){
				die $create_param->{namespace}, " override previos searcher ".
				$self->{_tables}[$self->{search_pos}]->{namespace}."\n";
				
			}
			$self->{search_pos} = $pos;
		}
	}
	
}
sub fields_to_tables {
	my ($self,$fields) = @_;
	if(UNIVERSAL::isa($fields,"ARRAY")){
		my %result;
		for my $field (@$fields){
			if(defined (my $pos = $self->{hash_fields}{$field})){
				$result{$pos}=1;
			}else{
				die "unexists fieled '$field' requested \n";
			}
		}
		return [keys %result];
	}elsif(UNIVERSAL::isa($fields,"HASH")){
		my %result;
		while(my ($f,$v) = each  %$fields){
			if(defined (my $pos = $self->{hash_fields}{$f})){
				${$result{$pos}}{$f} = $v;
			}else{
				die "unexists fieled '$f' requested \n";
			}
		}
		return \%result;
	}else{
		die "bad field list\n";
	}
}

sub get_obj {
	my ($self,$id,$readonly) = @_;
	die "Bad id='$id'" unless $id and 0 < $id and !ref $id;
	return bless {parent=>$self,id=>$id,readonly => $readonly},$self->{record_class};
}
sub get_by_name {
	my ($self,$name,$readonly) = @_;
	my ($pos,$obj);
	unless(defined($pos = $self->{search_pos})){
		die "cannot get by name without creator and searcher\n";
	}
	unless($obj = $self->{_tables}[$pos]->{object}->get_by_name($name,$readonly)){
		return undef;
	}
	my $robj = $self->get_obj($obj->{id},$readonly);
	$robj->{_tables}[$pos] = $obj;
	return $robj;
}
sub check_for_name {
	my ($self,$name) = @_;
	my ($pos);
	unless(defined($pos = $self->{search_pos})){
		die "cannot check for name without creator and searcher\n";
	}
	return $self->{_tables}[$pos]->{object}->check_for_name($name);
}
sub get_by_key {
	my ($self,$search_name,$name,$readonly) = @_;
	my ($pos,$obj);
	unless(defined($pos = $self->{searchers}{$search_name})){
		die "cannot get by name over '$search_name'\n";
	}
	unless($obj = $self->{_tables}[$pos]->{object}->get_by_name($name,$readonly)){
		return undef;
	}
	my $robj = $self->get_obj($obj->{id},$readonly);
	$robj->{_tables}[$pos] = $obj;
	return $robj;
}
sub check_for_key {
	my ($self,$search_name,$name) = @_;
	my $pos;
	unless(defined($pos = $self->{searchers}{$search_name})){
		die "cannot get by name over '$search_name'\n";
	}
	return $self->{_tables}[$pos]->{object}->check_for_name($name);
}
sub need_create {
	my $self = shift;
	unless(defined $self->{_need_create}){
		for my $obj(@{$self->{_tables}}){
			if($obj->{object}->need_create){
				return $self->{_need_create} = 1;
			}
		}
		for my $obj(@{$self->{_extern}}){
			if($obj->{object}->need_create){
				return $self->{_need_create} = 1;
			}
		}
		return $self->{_need_create} = 0;
	}
	return $self->{_need_create};
}
sub create {
	my $self = shift;
	my $id = shift;
	my $data;
	unless(@_){
		$data = {};
	}elsif(ref $_[0]){
		$data = shift;
	}else{
		if(@_ % 2){
			die "odd number params\n";
		}
		$data = {@_};
	}
	my $pos = $self->{create_pos};
	unless($id xor defined $pos){
		if($id){
			die "cannot together 'id' and 'create_name'\n";
		}else{
			die "cannot create without 'id' or 'create_name'\n";
		}
	}
	my $obj;
	my $tables = $self->fields_to_tables($data);
	if(defined $pos){
		my $creator = $self->{_tables}[$pos]->{object};
		$obj = $creator->create($tables->{$pos});
		$id = $obj->{id};
	}
	my $robj = $self->get_obj($id);
	for(my $i = $#{$self->{_tables}}; $i>=0; $i--){
		if(defined($pos) and $pos == $i){
			$robj->{_tables}[$i] = $obj;
		}else{
			my $creator = $self->{_tables}[$i]->{object};
			if($creator->need_create){
				$tables->{$i}{$creator->{pkey}} = $id;
				$robj->{_tables}[$i] = $creator->create($tables->{$i});
			}elsif($tables->{$i}){
				my $tmp = $robj->{_tables}[$i] = $creator->get_obj($id);
				$tmp->update_data($tables->{$i});
			}
		}
	}
	for(my $i = $#{$self->{_extern}}; $i>=0; $i--){
		my $creator = $self->{_extern}[$i]->{object};
		if($creator->need_create){
			$robj->{_extern}[$i] = $creator->create({$creator->{pkey} => $id});
		}
	}
	return $robj;
}

sub drop_context {
	my ($self,$id) = @_;
	$self->SUPER::drop_context($id);
	$_->{object}->drop_context($id) for(@{$self->{_tables}});
	$_->{object}->drop_context($id) for(@{$self->{_extern}});
}
sub clear_cache {
	my ($self,$id) = @_;
	$self->SUPER::clear_cache($id);
	$_->{object}->clear_cache($id) for(@{$self->{_tables}});
	$_->{object}->clear_cache($id) for(@{$self->{_extern}});
}

package NG::Sys::Cached::Mixed::Record;
use strict;
use warnings;
use utf8;

use NG::Sys::Cached::Common;
our @ISA = qw(NG::Sys::Cached::Common::Child);

sub obj_id {
	my ($self) = @_;
	return $self->{id};
}

sub __table {
	my ($self,$pos) = @_;
	return $self->{_tables}[$pos] ||= $self->{parent}{_tables}[$pos]->{object}->get_obj($self->{id},$self->{readonly});
}
sub __extern {
	my ($self,$pos) = @_;
	return $self->{_extern}[$pos] ||= $self->{parent}{_extern}[$pos]->{object}->get_obj($self->{id},$self->{readonly});
}
sub remove {
	my ($self) = @_;
	for(my $i = $#{$self->{parent}{_tables}}; $i >= 0; $i--){
		my $obj = $self->__table($i);
		$obj->remove;
	}
	for(my $i = $#{$self->{parent}{_extern}}; $i >= 0; $i--){
		my $obj = $self->__extern($i);
		$obj->remove;
	}
}
sub read_data {
	my ($self,$list) = @_;
	my $return_hash;
	my $tables;
	unless(defined $list){
		$return_hash = 1;
		$tables = [0 .. $#{$self->{parent}{_tables}}];
	}elsif(!ref $list){
		$list = [$list]
	}
	unless($tables){
		$tables = $self->{parent}->fields_to_tables($list);
	}
	my %result;
	for my $pos(@$tables){
		$result{$pos} = $self->__table($pos)->read_data;
	}
	if($return_hash){
		my %ret = map {%$_} grep {$_} @result{@$tables};
		return \%ret;
	}else{
		my $hash_fields = $self->{parent}{hash_fields};
		my @ret;
		for my $field (@$list){
			push @ret,$result{$hash_fields->{$field}}->{$field};
		}
		return wantarray ? @ret : $ret[0];
	}
}
sub update_data {
	unshift @_,'update_data';
	goto &__store_data;
}
sub replace_data {
	unshift @_,'replace_data';
	goto &__store_data;
}
sub __store_data {
	my $method = shift;
	my $self = shift;
	if($self->{readonly}){
		die "save readonly data\n";
	}
	my $sdata;
	if(ref $_[0]){
		$sdata = shift;
	}elsif(@_ % 2){
		die "odd number params\n";
	}else{
		$sdata = {@_};
	}
	$sdata = $self->{parent}->fields_to_tables($sdata);
	while(my($pos,$data) = each %$sdata){
		$self->__table($pos)->$method($data);
	}
	return 1;
}

our $AUTOLOAD;
sub AUTOLOAD {
	my $self = shift;
	(my $key = $AUTOLOAD) =~ s/.*://;
	
	if(defined(my $e = $self->{parent}{hash_extern}{$key})){
		my $obj = $self->__extern($e);
		return $obj;
	}
	
	$self->{parent}->check_field($key);

	if($self->{parent}{compile}){
		no strict 'refs';
		*{$AUTOLOAD} = $self->make_compiled($key);
		unshift @_,$self;
		goto &{$AUTOLOAD};
	}
	my $pos = $self->{parent}{hash_fields}{$key};
	return $self->__table($pos)->$key(@_);
}
sub make_compiled {
	my ($self,$key) = @_;
	my $pos = $self->{parent}{hash_fields}{$key};
	my $root = $self->{parent}{_tables}[$pos]->{object};
	return eval "sub {
		my \$self = shift;
		return (\$self->{_tables}[$pos] ||= \$root->get_obj(\$self->{id},\$self->{readonly}))->$key(\@_);
	}";
}
1;
